home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DRIVES.SWG / 0020_VOLABEL1.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  188 lines
  1. > I need a way to find the  volume Label of a drive.  Any  suggestions or
  2. > source code?
  3.  
  4. {$S-,R-,V-,I-,N-,B-,F-}
  5.  
  6. Unit Volume;
  7.  
  8. Interface
  9.  
  10. Uses
  11.   Dos;
  12.  
  13. Type
  14.  
  15.   Drive       = Byte;
  16.   VolumeName  = String [11];
  17.  
  18.   VolFCB      = Record
  19.     FCB_Flag : Byte;
  20.     Reserved : Array [1..5] of Byte;
  21.     FileAttr : Byte;
  22.     Drive_ID : Byte;
  23.     FileName : Array [1..8] of Byte;
  24.     File_Ext : Array [1..3] of Byte;
  25.     Unused_A : Array [1..5] of Byte;
  26.     File_New : Array [1..8] of Byte;
  27.     fExt_New : Array [1..3] of Byte;
  28.     Unused_B : Array [1..9] of Byte
  29.   end;
  30.  
  31. Function DelVol (D : Byte) : Boolean;
  32. Function AddVol (D : Byte; V : VolumeName) : Boolean;
  33. Function ChgVol (D : Byte; V : VolumeName) : Boolean;
  34. Function GetVol (D : Byte) : VolumeName;
  35.  
  36. Implementation
  37.  
  38. Procedure Pad_Name (Var V : VolumeName);
  39. begin
  40.   While LENGTH (V) <> 11 DO
  41.     V := V + ' '
  42. end;
  43.  
  44. Function Fix_Ext_Sym (Var V : VolumeName) : Byte;
  45. Var
  46.   I : Byte;
  47. begin
  48.   I := POS ('.', V);
  49.   if I > 0 then
  50.     DELETE (V, I, 1);
  51.   Fix_Ext_Sym := I
  52. end;
  53.  
  54. Function Extract_Name (S : SearchRec) : VolumeName;
  55. Var
  56.   H, I : Byte;
  57. begin
  58.   I := Fix_Ext_Sym (S.Name);
  59.   if (I > 0) and (I < 9) then
  60.     For H := 1 to (9 - I) DO
  61.       INSERT (' ', S.Name, I);
  62.   Extract_Name := S.Name
  63. end;
  64.  
  65. Procedure Fix_Name (Var V : VolumeName);
  66. Var
  67.   I : Byte;
  68. begin
  69.   Pad_Name (V);
  70.   For I := 1 to 11
  71.     do V [I] := UPCASE (V [I])
  72. end;
  73.  
  74. Function Valid_Drive_Num (D : Byte) : Boolean;
  75. begin
  76.   Valid_Drive_Num := (D >= 1) and (D <= 26)
  77. end;
  78.  
  79. Function Find_Vol (D : Byte; Var S : SearchRec) : Boolean;
  80. begin
  81.   FINDFIRST (CHR (D + 64) + ':\*.*', VolumeID, S);
  82.   Find_Vol := DosError = 0
  83. end;
  84.  
  85. Procedure Fix_FCB_NewFile (V : VolumeName; Var FCB : VolFCB);
  86. Var
  87.   I : Byte;
  88. begin
  89.   For I := 1 to 8 DO
  90.     FCB.File_New [I] := ORD (V [I]);
  91.   For I := 1 to 3 DO
  92.     FCB.fExt_New [I] := ORD (V [I + 8])
  93. end;
  94.  
  95. Procedure Fix_FCB_FileName (V : VolumeName; Var FCB : VolFCB);
  96. Var
  97.    I : Byte;
  98. begin
  99.   For I := 1 to 8 DO
  100.     FCB.FileName [I] := ORD (V [I]);
  101.   For I := 1 to 3 DO
  102.     FCB.File_Ext [I] := ORD (V [I + 8])
  103. end;
  104.  
  105. Function Vol_Int21 (Fnxn : Word; D : Drive; Var FCB : VolFCB) : Boolean;
  106. Var
  107.   Regs : Registers;
  108. begin
  109.   FCB.Drive_ID := D;
  110.   FCB.FCB_Flag := $FF;
  111.   FCB.FileAttr := $08;
  112.   Regs.DS     := SEG (FCB);
  113.   Regs.DX     := OFS (FCB);
  114.   Regs.AX     := Fnxn;
  115.   MSDos (Regs);
  116.   Vol_Int21 := Regs.AL = 0
  117. end;
  118.  
  119. Function DelVol (D : Byte) : Boolean;
  120. Var
  121.    sRec : SearchRec;
  122.    FCB  : VolFCB;
  123.    V    : VolumeName;
  124. begin
  125.   DelVol := False;
  126.   if Valid_Drive_Num (D) then
  127.   begin
  128.     if Find_Vol (D, sRec) then
  129.     begin
  130.       V := Extract_Name (sRec);
  131.       Pad_Name (V);
  132.       Fix_FCB_FileName (V, FCB);
  133.       DelVol := Vol_Int21 ($1300, D, FCB)
  134.     end
  135.   end
  136. end;
  137.  
  138. Function AddVol (D : Byte; V : VolumeName) : Boolean;
  139. Var
  140.   sRec : SearchRec;
  141.   FCB  : VolFCB;
  142. begin
  143.   AddVol := False;
  144.   if Valid_Drive_Num (D) then
  145.   begin
  146.     if not Find_Vol (D, sRec) then
  147.     begin
  148.       Fix_Name (V);
  149.       Fix_FCB_FileName (V, FCB);
  150.       AddVol := Vol_Int21 ($1600, D, FCB)
  151.     end
  152.   end
  153. end;
  154.  
  155. Function ChgVol (D : Byte; V : VolumeName) : Boolean;
  156. Var
  157.    sRec : SearchRec;
  158.    FCB  : VolFCB;
  159.    x    : Byte;
  160. begin
  161.   ChgVol := False;
  162.   if Valid_Drive_Num (D) then
  163.   begin
  164.     if Find_Vol (D, sRec) then
  165.     begin
  166.       x := Fix_Ext_Sym (V);
  167.       Fix_Name (V);
  168.       Fix_FCB_NewFile (V, FCB);
  169.       V := Extract_Name (sRec);
  170.       Pad_Name (V);
  171.       Fix_FCB_FileName (V, FCB);
  172.       ChgVol := Vol_Int21 ($1700, D, FCB)
  173.     end
  174.   end
  175. end;
  176.  
  177. Function GetVol (D : Byte) : VolumeName;
  178. Var
  179.   sRec : SearchRec;
  180. begin
  181.   GetVol := '';
  182.   if Valid_Drive_Num (D) then
  183.     if Find_Vol (D, sRec) then
  184.       GetVol := Extract_Name (sRec)
  185. end;
  186.  
  187. end.
  188.